home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d15 / infop141.arc / INFOPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-07  |  14KB  |  702 lines
  1. (*
  2. **  INFOPLUS.PAS
  3. **
  4. **  Version 1.41 by Andrew Rossmann 12/8/90
  5. *)
  6.  
  7. (*$A-,B-,D-,L-,F-,I-,N-,O-,R-,S-,V-*)
  8. (*$M 24576, 0, 0*)
  9. program INFOPLUS;
  10.  
  11. uses
  12.   crt, dos, graph, externs, scrprt;
  13.  
  14. const
  15.   qversion = 'Version 1.41';
  16.   qdate = 'December 8, 1990';
  17.   vernum = '1.41';
  18.   BIOSdseg = $0040;
  19.   pgmax = 18;
  20.   pchar = [' '..'~'];
  21.   secsiz = 1024;
  22.   tick1 = 1193180;
  23.   pgnames: array [0..18] of string[32] = (
  24.              'Table of Contents',
  25.              'Machine & ROM Identification',
  26.              'CPU Identification',
  27.              'RAM Identification',
  28.              'Memory Block Listing',
  29.              'Video Identification',
  30.              'Video Information',
  31.              'Keyboard & Mouse Information',
  32.              'Parallel/Serial Port Information',
  33.              'DOS Information',
  34.          {10}'Multiplex Programs',
  35.              'Environment Variables',
  36.              'Device Drivers',
  37.              'DOS Drive Information',
  38.              'BIOS Drive Information',
  39.              'Partition Table Listing',
  40.              'Boot info & DOS drive parameters',
  41.              'CMOS information',
  42.              'Thanks');
  43. type
  44.   char2 = string[2];
  45.  
  46. var
  47.   attrsave : byte;
  48.   country : array[0..33] of byte;
  49.   currdrv : byte;
  50.   devofs : word;
  51.   devseg : word;
  52.   dirsep : set of char;
  53.   DOScofs : word;
  54.   DOScseg : word;
  55.   DOSmem : longint;
  56.   equip : word;
  57.   graphdriver : integer;
  58.   i : word;
  59.   intvec : array[$00..$FF] of pointer;
  60.   lastdrv : byte;
  61.   osmajor : byte;
  62.   osminor : byte;
  63.   pg : 0..pgmax;
  64.   regs : registers;
  65.   switchar : char;
  66.   tlength : byte;
  67.   twidth : byte;
  68.   vidpg : byte;
  69.   x1 : byte;
  70.   x2 : byte;
  71.   xbool1 : boolean;
  72.   xbool2 : boolean;
  73.   xchar1 : char;
  74.   xchar2 : char;
  75.   xword : word;
  76.   gotcountry: boolean;
  77.   c2: char2;
  78.   quiet, endit: boolean;
  79.   ccode: word;
  80.   vidmode: word;
  81.   decimal: char;
  82.  
  83. function getkey2: char2;
  84.   var
  85.     c: char;
  86.     c2: char2;
  87.  
  88.   begin
  89.   c:=ReadKey;
  90.   if c = #0 then
  91.     getkey2:=c + ReadKey
  92.   else
  93.     getkey2:=c;
  94.   end; {getkey2}
  95.  
  96. {^Make sure number entered, not any letters}
  97. function getnum: word;
  98.   var
  99.     inpchar: char;
  100.     number_string: string[2];
  101.     temp, position, code: word;
  102.     row, col: byte;
  103.     finish: boolean;
  104.  
  105.   begin
  106.   row:=WhereY;
  107.   col:=WhereX;
  108.   Write(' ':3);
  109.   GotoXY(col, row);
  110.   temp:=99;
  111.   finish:=false;
  112.   position:=0;
  113.   number_string:='';
  114.   TextColor(LightGray);
  115.   repeat
  116.     inpchar:=ReadKey;
  117.     case inpchar of
  118.       '0'..'9':if position < 2 then
  119.         begin
  120.         Inc(position);
  121.         Inc(number_string[0]);
  122.         number_string[position]:=inpchar;
  123.         Write(inpchar)
  124.         end;
  125.       #8: if position > 0 then
  126.         begin
  127.         Dec(position);
  128.         Dec(number_string[0]);
  129.         Write(^H' '^H)
  130.         end;
  131.       #27: if number_string = '' then
  132.           finish:=true
  133.         else
  134.           begin
  135.           number_string:='';
  136.           GotoXY(col, row);
  137.           ClrEol;
  138.           position:=0
  139.           end;
  140.       #13: finish:=true
  141.     end {case}
  142.   until finish;
  143.   if number_string <> '' then
  144.     Val(number_string, temp, code);
  145.   getnum:=temp
  146.   end; {getnum}
  147.  
  148. procedure caption1(a: string);
  149.   begin
  150.   textcolor(LightGray);
  151.   write(a);
  152.   textcolor(LightCyan)
  153.   end; {caption1}
  154.  
  155. procedure caption2(a: string);
  156.   const
  157.     capterm = ': ';
  158.  
  159.   var
  160.     i: byte;
  161.     xbool: boolean;
  162.  
  163.   begin
  164.   i:=length(a);
  165.   while (i > 0) and (a[i] = ' ') do
  166.     dec(i);
  167.   insert(capterm, a, i + 1);
  168.   caption1(a)
  169.   end; {caption2}
  170.  
  171. function nocarry : boolean;
  172.   begin
  173.   nocarry:=regs.flags and fcarry = $0000
  174.   end; {nocarry}
  175.  
  176. function hex(a : word; b : byte) : string;
  177.   const
  178.     digit : array[$0..$F] of char = '0123456789ABCDEF';
  179.  
  180.   var
  181.     i : byte;
  182.     xstring : string;
  183.  
  184.   begin
  185.   xstring:='';
  186.   for i:=1 to b do
  187.     begin
  188.     insert(digit[a and $000F], xstring, 1);
  189.     a:=a shr 4
  190.     end;
  191.   hex:=xstring
  192.   end; {hex}
  193.  
  194. procedure unknown(a: string; b: word; c: byte);
  195.   begin
  196.   writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
  197.   end; {unknown}
  198.  
  199. procedure caption3(a : string);
  200.   begin
  201.   caption2('  ' + a)
  202.   end; {caption3}
  203.  
  204. procedure yesorno(a : boolean);
  205.   begin
  206.   if a then
  207.     writeln('yes')
  208.   else
  209.     writeln('no')
  210.   end; {yesorno}
  211.  
  212. procedure yesorno2(a: boolean);
  213.   begin
  214.   if a then
  215.     Write('yes')
  216.   else
  217.     Write('no')
  218.   end; {yesorno2}
  219.  
  220. procedure dontknow;
  221.   begin
  222.   writeln('(unknown)')
  223.   end; {dontknow}
  224.  
  225. procedure dontknow2;
  226.   begin
  227.   Write('(unknown)')
  228.   end; {dontknow2}
  229.  
  230. procedure segofs(a, b : word);
  231.   begin
  232.   write(hex(a, 4), ':', hex(b, 4))
  233.   end; {segofs}
  234.  
  235. function showchar(a : char) : char;
  236.   begin
  237.   if a in pchar then
  238.     showchar:=a
  239.   else
  240.     showchar:='.'
  241.   end; {showchar}
  242.  
  243. function power2(y: word): longint;
  244.   begin
  245.   power2:=Trunc(exp((y * 1.0) * ln(2.0)))
  246.   end;
  247.  
  248. procedure pause1;
  249.   var
  250.     xbyte : byte;
  251.     xchar : char2;
  252.     savex, savey: byte;
  253.  
  254.   begin
  255.   xbyte:=textattr;
  256.   endit:=false;
  257.   textcolor(Cyan);
  258.   savex:=WhereX;
  259.   savey:=WhereY;
  260.   Write('( for more)');
  261.   xchar:=getkey2;
  262.   if xchar <> #0#80 then
  263.     begin
  264.     endit:=true;
  265.     c2:=xchar
  266.     end;
  267.   textattr:=xbyte;
  268.   GotoXY(savex, savey);
  269.   Write('            ')
  270.   end; {pause1}
  271.  
  272. procedure pause2;
  273.   var
  274.     xbyte : byte;
  275.  
  276.   begin
  277.   if wherey + hi(windmin) > hi(windmax) then
  278.     begin
  279.     xbyte:=TextAttr;
  280.     TextColor(Cyan);
  281.     pause1;
  282.     if not endit then
  283.       begin
  284.       Clrscr;
  285.       Writeln('(continued)');
  286.       end;
  287.     textattr:=xbyte
  288.     end
  289.   end; {pause2}
  290.  
  291. procedure pause3(extra: byte);
  292.   var
  293.     xbyte: byte;
  294.   begin
  295.   if WhereY + Hi(WindMin) + extra > Hi(WindMax) then
  296.     begin
  297.     xbyte:=TextAttr;
  298.     TextColor(Cyan);
  299.     pause1;
  300.     if not endit then
  301.       begin
  302.       ClrScr;
  303.       Writeln('(continued)');
  304.       end;
  305.     TextAttr:=xbyte
  306.     end
  307.   end; {pause3}
  308.  
  309. function bin4(a : byte) : string;
  310.   const
  311.     digit : array[0..1] of char = '01';
  312.  
  313.   var
  314.     xstring : string;
  315.     i : byte;
  316.  
  317.   begin
  318.   xstring:='';
  319.   for i:=3 downto 0 do
  320.     begin
  321.     insert(digit[a mod 2], xstring, 1);
  322.     a:=a shr 1
  323.     end;
  324.   bin4:=xstring
  325.   end; {bin4}
  326.  
  327. procedure offoron(a : string; b : boolean);
  328.   begin
  329.   caption3(a);
  330.   if b then
  331.     writeln('on')
  332.   else
  333.     writeln('off')
  334.   end; {offoron}
  335.  
  336. procedure zeropad(a : word);
  337.   begin
  338.   if a < 10 then
  339.     write('0');
  340.   write(a)
  341.   end; {zeropad}
  342.  
  343. procedure showvers;
  344.   begin
  345.   if osmajor > 0 then
  346.     begin
  347.     Write(osmajor, decimal);
  348.     zeropad(osminor);
  349.     writeln
  350.     end
  351.   else
  352.     writeln('1', decimal, 'x')
  353.   end; {showvers}
  354.  
  355. function cbw(a, b : byte) : word;
  356.   begin
  357.   cbw:=word(b) shl 8 + a
  358.   end; {cbw}
  359.  
  360. function bin16(a : word) : string;
  361.   function bin8(a : byte) : string;
  362.     begin
  363.     bin8:=bin4(a shr 4) + '_' + bin4(a and $0F)
  364.     end; {bin8}
  365.  
  366.   begin {bin16}
  367.   bin16:=bin8(hi(a)) + '_' + bin8(lo(a))
  368.   end; {bin16}
  369.  
  370. procedure drvname(a : byte);
  371.   begin
  372.   write(chr(ord('A') + a), ': ')
  373.   end; {drvname}
  374.  
  375. procedure media(a, b : byte);
  376.   procedure diskette(a, b, c : byte);
  377.     begin
  378.     writeln('floppy ', a, ' side, ', b, ' sctr, ', c, ' trk')
  379.     end; {diskette}
  380.  
  381.   begin {media}
  382.   caption3('Media');
  383.   case a of
  384.     $FF : diskette(2, 8, 40);
  385.     $FE : diskette(1, 8, 40);
  386.     $FD : diskette(2, 9, 40);
  387.     $FC : diskette(1, 9, 40);
  388.     $F9 : if b = 1 then
  389.       diskette(2, 15, 80)
  390.     else
  391.       diskette(2, 9, 80);
  392.     $F8 : writeln('fixed disk');
  393.     $F0 : diskette(2, 18, 80)
  394.     else
  395.       unknown('media', a, 2)
  396.   end
  397.   end; {media}
  398.  
  399. procedure pagenameclr;
  400.   var
  401.     xbyte: byte;
  402.  
  403.   begin
  404.   xbyte:=TextAttr;
  405.   Window(x1, tlength, x2 - 1, tlength);
  406.   TextColor((TextAttr and $70) shr 4);
  407.   ClrScr;
  408.   TextAttr:=xbyte;
  409.   Window(1, 1, twidth, tlength)
  410.   end; {pagenameclr}
  411.  
  412. procedure Intr(intno: byte; var regs: registers);
  413.   begin
  414.   AltIntr(intno, regs)
  415.   end;
  416.  
  417. procedure MsDos(var regs: registers);
  418.   begin
  419.   AltMsDos(regs)
  420.   end;
  421.  
  422. procedure init;
  423.   var
  424.     xint : integer;
  425.  
  426.   procedure rjustify(a : string);
  427.     begin
  428.     gotoxy(1 + lo(windmax) - length(a), wherey);
  429.     x2:=WhereX;
  430.     write(a)
  431.     end; {rjustify}
  432.  
  433.   procedure border(ch: char);
  434.     var
  435.       i : byte;
  436.  
  437.     begin
  438.     TextColor(LightCyan);
  439.     for i:=1 to twidth do
  440.       write(ch);
  441.     TextColor(LightGray);
  442.     end; {border}
  443.  
  444.   begin {init}
  445.   mono:=false;
  446.   vidmode:=LastMode;
  447.   attrsave:=textattr;
  448.   if (Lo(LastMode) = 0) or (Lo(LastMode) = 1) then
  449.     TextMode(LastMode + 2);
  450.   with regs do
  451.     begin
  452.     AH:=$0F;
  453.     intr($10, regs);
  454.     twidth:=AH;
  455.     vidpg:=BH
  456.     end;
  457.   detectgraph(graphdriver, xint);
  458.   if (graphdriver = EGA) or (graphdriver = MCGA) or (graphdriver = VGA) then
  459.     with regs do
  460.       begin
  461.       AX:=$1130;
  462.       BH:=$00;
  463.       intr($10, regs);
  464.       tlength:=DL + 1;
  465.       CheckSnow:=False;
  466.       end
  467.   else
  468.     tlength:=25;
  469.   with regs do
  470.     begin
  471.     intr($11, regs);
  472.     equip:=AX;
  473.     intr($12, regs);
  474.     DOSmem:=longint(AX) shl 10;
  475.     AH:=$19;
  476.     MSDOS(regs);
  477.     currdrv:=AL;
  478.     AH:=$34;
  479.     MSDOS(regs);
  480.     DOScseg:=ES;
  481.     DOScofs:=BX
  482.     end;
  483.   for i:=$00 to $FF do
  484.     getintvec(i, intvec[i]);
  485.   intvec[$00]:=saveint00;
  486.   intvec[$02]:=saveint02;
  487.   intvec[$1B]:=saveint1B;
  488.   intvec[$23]:=saveint23;
  489.   intvec[$24]:=saveint24;
  490.   intvec[$34]:=saveint34;
  491.   intvec[$35]:=saveint35;
  492.   intvec[$36]:=saveint36;
  493.   intvec[$37]:=saveint37;
  494.   intvec[$38]:=saveint38;
  495.   intvec[$39]:=saveint39;
  496.   intvec[$3A]:=saveint3A;
  497.   intvec[$3B]:=saveint3B;
  498.   intvec[$3C]:=saveint3C;
  499.   intvec[$3D]:=saveint3D;
  500.   intvec[$3E]:=saveint3E;
  501.   intvec[$3F]:=saveint3F;
  502.   intvec[$75]:=saveint75;
  503.   with regs do
  504.     begin
  505.     AX:=$3700;
  506.     MSDOS(regs);
  507.     switchar:=chr(DL)
  508.     end;
  509.   dirsep:=['\'];
  510.   if switchar <> '/' then
  511.     dirsep:=dirsep + ['/'];
  512.   with regs do
  513.     begin
  514.     AH:=$52;
  515.     MSDOS(regs);
  516.     devseg:=ES;
  517.     devofs:=BX
  518.     end;
  519.   lastdrv:=mem[devseg : devofs + $0021];
  520.   if (Lo(LastMode) = 2) or (Lo(LastMode) = 7) then
  521.     mono:=true;
  522.   TextBackground(Blue);
  523.   clrscr;
  524.   textcolor(LightGreen);
  525.   write('INFO+');
  526.   textcolor(lightgray);
  527.   write(' - Information on all computer functions');
  528.   rjustify(qversion);
  529.   writeln;
  530.   border(#223);
  531.   gotoxy(1, tlength - 1);
  532.   border(#220);
  533.   write('Page ');
  534.   x1:=wherex;
  535.   textcolor(Lightgreen);
  536.   rjustify('Enter PgUp PgDn Home End Esc Alt-P');
  537.   pg:=0;
  538.   endit:=false;
  539.   if osmajor >= 3 then
  540.     with regs do
  541.       begin
  542.       AX:=$3800;
  543.       DS:=seg(country);
  544.       DX:=ofs(country);
  545.       MSDOS(regs);
  546.       ccode:=BX;
  547.       decimal:=Chr(country[9]);
  548.       end;
  549.   end; {init}
  550.  
  551. {$I PAGE_00.PAS}
  552. {$I PAGE_01.PAS}
  553. {$I PAGE_02.PAS}
  554. {$I PAGE_03.PAS}
  555. {$I PAGE_04.PAS}
  556. {$I PAGE_05.PAS}
  557. {$I PAGE_06.PAS}
  558. {$I PAGE_07.PAS}
  559. {$I PAGE_08.PAS}
  560. {$I PAGE_09.PAS}
  561. {$I PAGE_10.PAS}
  562. {$I PAGE_11.PAS}
  563. {$I PAGE_12.PAS}
  564. {$I PAGE_13.PAS}
  565. {$I PAGE_14.PAS}
  566. {$I PAGE_15.PAS}
  567. {$I PAGE_16.PAS}
  568. {$I PAGE_17.PAS}
  569. {$I PAGE_18.PAS}
  570.  
  571. begin
  572.   xword:=dosversion;
  573.   osmajor:=lo(xword);
  574.   osminor:=hi(xword);
  575.   if osmajor >= 3 then
  576.     begin
  577.     init;
  578.     xbool1:=false;
  579.     repeat
  580.       pagenameclr;
  581.       gotoxy(x1, tlength);
  582.       textcolor(lightgray);
  583.       write(pg:2, ' - ');
  584.       Write(pgnames[pg]);
  585.       window(1, 3, twidth, tlength - 2);
  586.       clrscr;
  587.       case pg of
  588.         0 : page_00;
  589.         1 : page_01;
  590.         2 : page_02;
  591.         3 : page_03;
  592.         4 : page_04;
  593.         5 : page_05;
  594.         6 : page_06;
  595.         7 : page_07;
  596.         8 : page_08;
  597.         9 : page_09;
  598.         10 : page_10;
  599.         11 : page_11;
  600.         12 : page_12;
  601.         13 : page_13;
  602.         14 : page_14;
  603.         15 : page_15;
  604.         16 : page_16;
  605.         17 : page_17;
  606.         18 : page_18;
  607.       end;
  608.       xbool2:=false;
  609.       repeat
  610.         Window(1, 1, twidth, tlength);
  611.         GotoXY(x2 - 1, tlength);
  612.         quiet:=false;
  613.         if not endit then
  614.           begin
  615.           repeat
  616.           until keypressed;
  617.           xchar1:=readkey;
  618.           if keypressed then
  619.             xchar2:=readkey
  620.           else
  621.             xchar2:=#0;
  622.           end
  623.         else
  624.           begin
  625.           endit:=false;
  626.           xchar1:=c2[1];
  627.           if Length(c2) = 1 then
  628.             xchar2:=#0
  629.           else
  630.             xchar2:=c2[2]
  631.           end;
  632.         if (xchar1 = #27) and (xchar2 = #0) then
  633.           begin
  634.           xbool2:=true;
  635.           xbool1:=true
  636.           end;
  637.         if (xchar1 = #13) and (xchar2 = #0) then
  638.           begin
  639.           pagenameclr;
  640.           GotoXY(x1, tlength);
  641.           TextColor(White);
  642.           Write('Go to page no.=> ');
  643.           i:=getnum;
  644.           if (i >= 0 ) and (i <= pgmax) then
  645.             begin
  646.             pg:=i;
  647.             xbool2:=true
  648.             end;
  649.           pagenameclr;
  650.           gotoxy(x1, tlength);
  651.           textcolor(lightgray);
  652.           write(pg:2, ' - ');
  653.           Write(pgnames[pg]);
  654.           end;
  655.         if xchar1 = #0 then
  656.           case xchar2 of
  657.             #71: begin
  658.                  xbool2:=true;
  659.                  pg:=0
  660.                  end;
  661.             #73: if pg > 0 then
  662.                    begin
  663.                    xbool2:=true;
  664.                    Dec(pg)
  665.                    end;
  666.             #79: begin
  667.                  xbool2:=true;
  668.                  pg:=pgmax
  669.                  end;
  670.             #81: if pg < pgmax then
  671.                    begin
  672.                    xbool2:=true;
  673.                    Inc(pg)
  674.                    end;
  675.             #25: begin
  676.                  screenprint(pg, pgnames[pg], vernum);
  677.                  xbool2:=false;
  678.                  quiet:=true;
  679.                  end;
  680.           end;
  681.       if (not xbool2) and (not quiet) then
  682.         begin
  683.         Sound(220);
  684.         Delay(100);
  685.         NoSound
  686.         end
  687.       until xbool2
  688.     until xbool1;
  689.     textattr:=attrsave;
  690.     TextMode(vidmode);
  691.     clrscr
  692.   end
  693. else
  694.   begin
  695.   writeln;
  696.   decimal:='.';
  697.   writeln('INFOPLUS requires DOS version 3.0 or later');
  698.   write('Your DOS version is ');
  699.   showvers
  700.   end
  701. end.
  702.